Pascal Super Library/Pascal Super Library (CW International)(1997).bin/ICON_UTL/TPICONS/ICONMAN.PAS

Pascal/Delphi Source File | 1993-05-20 | 9KB | 227 lines

{---------------------------------------------------------------------------}
{ UNIT     : ICONMAN.PAS - Version 1.0                                      }
{                                                                           }
{ FUNCTION : Provides Icon Management Routines.                             }
{                                                                           }
{ AUTHOR   : Andy Denton - 06/08/91                                         }
{                                                                           }
{---------------------------------------------------------------------------}

UNIT ICONMAN;

INTERFACE

USES Graph;

{--------------------------------------------------------------------}
{ The following Procedures, Constants and Variables are visible to   }
{ the calling Programs.                                              }
{--------------------------------------------------------------------}
TYPE
  BorderType = (Border,NoBorder);

VAR
  FLoadResult   : INTEGER;
  ICreateResult : INTEGER;

PROCEDURE OpenIconSystem;
PROCEDURE CloseIconSystem;
PROCEDURE LoadIconFile(Filename : STRING);
PROCEDURE SaveIconFile(Filename : STRING);
PROCEDURE DisplayIcon(Ino : INTEGER; Ix,Iy : INTEGER; BordTyp : BorderType; Color: WORD);
PROCEDURE GetNumberOfIcons(VAR NoIco : INTEGER);
PROCEDURE CreateIcon(Ino : INTEGER; Ix,Iy : INTEGER);
PROCEDURE ReplaceIcon(Ino : INTEGER; Ix,Iy : INTEGER);
PROCEDURE SetIconCount(MaxIco : INTEGER);

{--------------------------------------------------------------------}
{ The following Procedures, Constants and Variables are Private and  }
{ are not visible to the calling Programs.                           }
{--------------------------------------------------------------------}

IMPLEMENTATION

CONST
  Icon_Size : WORD    = 518;  { Number of bytes per 32x32 bit icon. }
  Max_Icons : INTEGER = 32;   { Maximum number of icons per file.   }

TYPE
  Icon_Record = RECORD        { Makes up Icon_Stack array. }
  Icon_Pointer : POINTER;
  END;

VAR
  Loop         : INTEGER;
  Number_Icons : BYTE;        { Number of icons in current file. }
  F1           : FILE;
  Current_File : STRING;      { Name of current file. }
  result       : WORD;
  HeapTop      : ^WORD;       { Marks bottom of reserved }
                              { space for Icon_Stack.    }

  Icon_Stack   : ARRAY[1..32] OF Icon_Record; { Holds 32 icons }

{--------------------------------------------------------------------}
{ (1) OpenIconSystem                                                 }
{                                                                    }
{ Reserve memory for all 32 icons on the heap.                       }
{--------------------------------------------------------------------}

PROCEDURE OpenIconSystem;
BEGIN
  FOR loop:=1 TO Max_Icons DO
  BEGIN
    GetMem(Icon_Stack[Loop].Icon_Pointer, Icon_Size);  { Reserve memory for }
  END;                                                 { all 32 icons       }
END;

{--------------------------------------------------------------------}
{ (2) CloseIconSystem                                                }
{                                                                    }
{ Discards heap memory used to hold all 32 icons.                    }
{--------------------------------------------------------------------}

PROCEDURE CloseIconSystem;
BEGIN
 FOR loop:=1 TO Max_Icons DO
  BEGIN
    FreeMem(Icon_Stack[Loop].Icon_Pointer,Icon_Size);  { Restore memory taken }
  END;                                                 { by all 32 icons      }
END;

{--------------------------------------------------------------------}
{ (3) PROCEDURE LoadIconFile                                         }
{                                                                    }
{ Loads an icon datafile (.IDF) into the Icon_Stack array.           }
{--------------------------------------------------------------------}

PROCEDURE LoadIconFile(FileName : STRING);
BEGIN
  Assign(f1,FileName);
  Reset(f1,1);                   { Reposition file pointer & record len = 1 }
  FloadResult:=IOResult;
  IF FLoadResult=0 THEN
  BEGIN
    Current_File:=FileName;
    BlockRead(f1,Number_Icons,1,result);     { Read number of icons in file }
    FOR Loop:=1 TO Max_Icons DO
    BEGIN
      BlockRead(f1,Icon_Stack[Loop].Icon_Pointer^,Icon_Size,result);    { Read Icon }
    END;
  Close(f1);
  END
  ELSE
    Number_Icons:=0;
END;

{--------------------------------------------------------------------}
{ (4) PROCEDURE SaveIconFile                                         }
{                                                                    }
{ Saves the Icon_Stack array to an icon datafile (.IDF) on disk.     }
{--------------------------------------------------------------------}

PROCEDURE SaveIconFile(FileName : STRING);
BEGIN
  IF FileName <>'' THEN
  BEGIN
    Assign(f1,FileName);
    Rewrite(f1,1);                                  { Clear file & set record size to 1 }
    BlockWrite(f1,Number_Icons,1,result);           { Write Icon number }
    FOR loop:=1 TO Max_Icons Do
    BEGIN
      BlockWrite(f1,Icon_Stack[Loop].Icon_Pointer^,Icon_Size,result);  { Save Icon }
    END;
    Close(f1);
  END;
END;

{--------------------------------------------------------------------}
{ (5) DisplayIcon                                                    }
{                                                                    }
{ Display an icon at a given X,Y screen coordinate.                  }
{--------------------------------------------------------------------}

PROCEDURE DisplayIcon(Ino : INTEGER; Ix,Iy : INTEGER; BordTyp : BorderType; Color: WORD);
VAR
  OldColor : WORD;
BEGIN
  IF (Ino<=Number_Icons) AND (Ino>=1) THEN
  PutImage(Ix,Iy,Icon_Stack[Ino].Icon_Pointer^, CopyPut);

  IF BordTyp=Border THEN
  BEGIN
    OldColor:=GetColor;
    SetColor(Color);
    Rectangle(Ix-1,Iy-1,Ix+32,Iy+32);
    SetColor(OldColor);
  END;
END;

{--------------------------------------------------------------------}
{ (6) GetNumberOfIcons                                               }
{                                                                    }
{ Returns the number of currently defined icons.                     }
{--------------------------------------------------------------------}

PROCEDURE GetNumberOfIcons(VAR NoIco : INTEGER);
BEGIN
  NoIco:=Number_Icons;
END;

{--------------------------------------------------------------------}
{ (7) CreateIcon                                                     }
{                                                                    }
{ This allows the user to grab part of one of their screens in any   }
{ of their existing Turbo Pascal programs and use it as an icon.     }
{--------------------------------------------------------------------}

PROCEDURE CreateIcon(Ino : INTEGER; Ix,Iy : INTEGER);
BEGIN
  ICreateResult:=0; { Ok }
  IF (Ino<=(Number_Icons+1)) AND (Ino<=Max_Icons) AND (Ix+31<=639)
  AND (Iy+31<=479) THEN
  BEGIN
    Getimage(Ix,Iy,Ix+31,Iy+31,Icon_Stack[Ino].Icon_Pointer^);
    IF (Number_Icons<Max_Icons) THEN INC(Number_Icons);
  END
  ELSE
  BEGIN
    IF (Ino>=(Number_Icons+1)) OR (Ino>Max_Icons) THEN ICreateResult:=1;  { Invalid Icon }
    IF (Ix+31>639) OR (Iy+31>479) THEN ICreateResult:=2;     { Part of the icon would be }
  END;                                                       { grabbed from off screen   }
END;

{--------------------------------------------------------------------}
{ (8) ReplaceIcon                                                    }
{                                                                    }
{ This allows the user to grab part of one of their screens in any   }
{ of their existing Turbo Pascal programs and use it to replace an   }
{ existing icon.                                                     }
{--------------------------------------------------------------------}

PROCEDURE ReplaceIcon(Ino : INTEGER; Ix,Iy : INTEGER);
BEGIN
  IF (Ino<=(Number_Icons)) AND (Ix+31<=639)
  AND (Iy+31<=479) THEN
  BEGIN
    Getimage(Ix,Iy,Ix+31,Iy+31,Icon_Stack[Ino].Icon_Pointer^);
  END
END;

{--------------------------------------------------------------------}
{ (9) SetIconCount                                                   }
{                                                                    }
{ Used to register a new icon. When an icon datafile is saved, the   }
{ variable Number_Icons is saved at the begining of the file.        }
{--------------------------------------------------------------------}

PROCEDURE SetIconCount(MaxIco : INTEGER);
BEGIN
   IF (MaxIco>=0) AND (MaxIco<=32) THEN
   BEGIN
     Number_Icons:=MaxIco;
   END;
END;

END.